perm filename SCMSS.F4[NEW,LCS]11 blob
sn#337809 filedate 1978-02-27 generic text, type T, neo UTF8
C****** SCMSS *********** 12/1/75
SUBROUTINE SCMSS
COMMON /PLTR/PLT,RHT,DIS/PTR/KWDS(1)
COMMON/RINP/R(10,85),RPOS(2,50) /RMOD/RMODE2,SET4,IBEAM,
1 NOSET,STEM,STUP,NTC,PS2,RAM,RDD,ITB,POSB
COMMON R2,JA,G,H,R3,U(39)/SCM/V(78),I,LCNT,STAFF,JLIST(200),REND
C JLIST WILL SOMETIMES BE USED(WIPED OUT) FOR R(X,Y) OVERFLOW(>50 ITEMS.)
DIMENSION RLIST(200),NOMOR(6),WARN(6),ISV(5)
C /SCX/ ALSO IN WORDS, NEWR
COMMON/SCX/JALPHA(30),RB,RC,JZ,IRHY,JD,KA,KB,IZ
1/STF/RSTFAC(8),RSTJ2 /LIMIT/LIMIT,ITEM,LL,IS,IX
1 /FRMT/F78F(1),FA1(1),FA5(1),IREAD
1/XRN/RN(1) /ALF/INP(72),ML /POS/POS1,POS2,PSFB
COMMON /SC/J,L,MK,ISKP,XMINUS,N,IEXP,LK,NNUM,JJ,JN,DBST
1,NFLG,IXX,ISEMI,JG,VX(50),IAMP,K,KN,M,MODE,IBLA
EQUIVALENCE (VX1,VX(1)),(INP1,INP(1)),(VX2,VX(2)),(VX3,VX(3)),
1(VX4,VX(4)),(VX5,VX(5)),(JLIST,RLIST)
1 ,(INP2,INP(2)),(INP3,INP(3)),(INP4,INP(4))
1,(ISTAR,JALPHA(8)),(ICOL,JALPHA(9)),(IRP,JALPHA(6)),
1(ILP,JALPHA(5)),(NEG,JALPHA(2)),(IAT,JALPHA(16)),(IDOT,
1JALPHA(3))
DATA IXX/'X'/,LCNT/1/,ISEMI/';'/,IBLA/' '/,KSLA/'/'/
CC ISX=IS
C SAVE RN COUNTER FOR ZERO FEATURE AT 168
1177 IF(JA.EQ.14)GO TO 77
IF(JA.NE.144)GO TO 11
77 MODE=1
POS2=0
POS1=0
CC THIS IS SET IN MSX NOW **** RMODE2=R3
CALL TYPSTR('SPACING STAFF =')
CALL TYPFLT(SET4)
CALL TYPCRLF
CCC TYPE 444,SET4
IBEAM=-1
IZ=0
IREAD=0
11 IF(IREAD)GO TO 2304
IF(JA.EQ.144)GO TO 2302
CALL TYPCRLF
GO TO (1,2,3,4,5,69)MODE
2302 IF(IREAD)GO TO 2304
REREAD 80052,L,L,L,STAFF,RMODE2
GO TO 2177
2304 IF(IREAD.EQ.-1)REREAD 21141,L,INP
IF(IREAD.EQ.-2)REREAD 2114,INP
CC2303 IF(INP(1).NE.ISTAR)GO TO 231
2303 RB=0
IF(INP(1).NE.ISTAR)GO TO 2311
REREAD 2310,L,SET4,STAFF,POS1,POS2,PSFB
C READS SPACING STAFF NUM, THIS STAFF NUM, AND POSITIONS.
C FIRST CHAR. MUST BE * . !!! ASSUMES NO LINE NUMBERS NOW!!!
IF(POS2.EQ.0)POS2=200
READ(22,2114)INP
RB=-1
GO TO 2311
C TAKE OUT OLD STAFF NUM SETUP ONE OF THESE DAYS.
2311 CALL TYPSTR('STAFF NUM=')
CCC2311 TYPE 80053
IF(RB)GO TO 231
IF(STFNUM(STAFF))GO TO 2305
CCC231 TYPE 80052,STAFF
231 CALL TYPFLT(STAFF)
CCC IF(RB)TYPE 444,SET4
IF(RB.GE.0)GO TO 4177
CALL TYPCRLF
CALL TYPSTR('SPACING STAFF =')
CALL TYPFLT(SET4)
CALL TYPCRLF
C FILE CAN SET STAFF # AND SPACING STAFF # (STn/SPn/)
CC IF(JA.EQ.144)GO TO 2177
GO TO 4177
2305 ACCEPT 80052,STAFF
IF(STAFF.NE.444)GO TO 2177
REREAD 4177,RA,RB
IF(RA.NE.'SP')GO TO 4177
C NOW SPACER CAN BE SET AT THIS POINT
SET4=RB
GO TO 2303
4177 FORMAT(A2,F)
2310 FORMAT(A1,5F)
CO TYPE 8009,MODE,INP
2177 IF(IREAD)CALL TYPOUT
IF(STAFF.GE.99)GO TO 690
C TYPE 99 OR 999 TO ESCAPE WHEN IN READ-IN MODE
REND=0
IF(IREAD)GO TO 80041
IF(LOOK(L)+LOOKD(L))GO TO 101
CALL TYPSTR('FILE NOT FOUND - ')
CALL TYPWRD(L)
CALL TYPCRLF
CCC TYPE 101,L
GO TO 690
CC101 FORMAT(' FILE NOT FOUND - ',A5)
101 IREAD=-1
C FOR 1ST TIME IN BEAMS.
REWIND 22
CALL IFILE(22,L)
2301 IF(IREAD.EQ.-2)GO TO 2307
READ(22,21141,END=68),L,INP
IF(L.NE.0)GO TO 2300
C JUMP IF LINE NUMBERS
IF(INP1.EQ.'O')GO TO 2307
IREAD=-2
C THIS IS FOR NON-'ET' FILES WITH NO LINE NUMBS.
REREAD 2114,INP
GO TO 2300
2307 READ(22,2114,END=68)INP
IF(IREAD.EQ.-2)GO TO 2300
IF(INP3.NE.ISEMI)GO TO 2307
IREAD=-2
READ(22,2114)INP
GO TO 2307
2300 IF(JA.NE.144)GO TO 2308
IF(MODE.EQ.1)GO TO 2303
2308 IF(MODE.EQ.6)GO TO 1111
IF(INP1.EQ.IBLA)GO TO 8006
IF(INP1.EQ.ISEMI)GO TO 8006
C 'ET' FILES MUST HAVE ';' AS 1ST CHAR. BLANK LINES ARE IGNORED!!
CO TYPE 8009,MODE,INP
CALL TYPOUT
GO TO 6177
1111 MODE=1
REND=2
IZ=0
RETURN
C ABOVE ALLOWS MORE STAVES TO BE READ
CC168 IF(NOSET.EQ.0)RETURN
C NEXT NO LONGER NEEDED (I HOPE!)
CC L=ISX
CC2168 RA=RN(L+1)
CC IF(RA.EQ.1)GO TO 3168
CC IF(RA.NE.2)GO TO 1168
CC N=7
CC GO TO 4168
CC3168 IF(RN(L).LT.7)GO TO 1168
C SKIP NOTES SANS RHYTH. (CHORD NOTES.)
CC N=9
CC4168 RN(L+N)=0
C ZEROS RHYTHM OF ADDED INPUT ON SPACING STAFF
CC1168 L=L+RN(L)+3
CC IF(L.LT.IS)GO TO 2168
CC RETURN
CCC80053 FORMAT(' STAFF NUM='$)
80052 FORMAT(F,A4,A5,2F)
CCC444 FORMAT(' SPACING STAFF =',F3.0)
4 CALL TYPSTR('ADD BEAMS? ')
CCC4 TYPE 8002
CC330 ACCEPT 2114,N,L,INP3,INP4
330 ACCEPT 2114,INP
IF(INP1.EQ.'G')GO TO 69
C TYPE 'GO' TO PASS LATER ITEMS
IF(INP1.EQ.'9')GO TO 99
IF(INP1.EQ.'B')GO TO 99
IF(INP1.EQ.'Y')GO TO 1
DO 2001 K=2,6
2001 IF(INP(K).EQ.'B')GO TO 134
C FOR BEAMS? TYPE 'nB' INSTEAD OF 'Y' FOR AUTOMATIC.
IF(INP1.EQ.'N')GO TO 2000
IF(INP1.NE.IBLA)GO TO 11
C PICKS UP TYPOS
2000 MODE=MODE+1
WRITE(21,2114)INP4
GO TO 11
CCC691 FORMAT(' INPUT SAVED ON FOR21.DAT')
69 END FILE 21
CALL TYPSTR('INPUT SAVED ON FOR21.DAT')
CALL TYPCRLF
CCC TYPE 691
690 REND=1
RETURN
CC GO TO 168
3 CALL TYPSTR('ADD MARKS? ')
CCC3 TYPE 8023
GO TO 330
5 CALL TYPSTR('ADD SLURS? ')
CCC5 TYPE 8022
GO TO 330
8006 MODE=MODE+1
IF(MODE.NE.2)GO TO 177
IF(RMODE2.EQ.2)GO TO 80041
C FOR NEW INPUT FORMAT -- TYPE 14 2 OR 144 -2 ETC.
177 IF(IREAD)GO TO 2301
IF(MODE.LE.5)RETURN
END FILE 21
CALL TYPSTR('INPUT SAVED ON FOR21.DAT')
CALL TYPCRLF
CCC TYPE 691
68 REND=-1
RETURN
CC GO TO 168
99 IF(INP3.EQ.'9')GO TO 999
C ELSE GET ANOTHER CHANCE TO SAY 'NO'. 99=BACKUP, 999=ESCAPE
MODE=MODE-1
IF(MODE.EQ.0)GO TO 999
IS=ISV(MODE)
GO TO 11
C INSERT BACKUP ROUTINE
999 REND=99
RETURN
C FIX BACKUPS********
CCC8008 FORMAT(' TYPE ',I2,' RHYTHMS')
CCC8002 FORMAT(' ADD BEAMS? '$)
CCC8022 FORMAT(' ADD SLURS? '$)
CCC8023 FORMAT(' ADD MARKS? '$)
CO8009 FORMAT(I2,4X,72A1)
CCC8011 FORMAT(' TOTAL RHY=',F7.3,' QTRS.',
CCC 1 I5,' MORE RHYTHMS NEEDED'/)
8015 RA=0
DO 15 J=1,I-1
15 RA=RA+V(J)
RA=RA/4.
K=IRHY-I+1
CALL TYPSTR('TOTAL RHY=')
CALL TYPFLT(RA)
CALL TYPSTR(' QTRS. ')
CALL TYPINT(K)
CALL TYPSTR(' MORE RHYTHMS NEEDED')
CALL TYPCRLF
CCC TYPE 8011,RA,K
IF(IREAD)IREAD=-IREAD
C ↑↑↑↑↑ SO YOU CAN TYPE MORE LINES WHEN ERROR ON READIN.
2 CALL TYPSTR('TYPE ')
CALL TYPINT(IRHY)
CALL TYPSTR(' RHYTHMS')
CALL TYPCRLF
CCC2 TYPE 8008,IRHY
1 ISV(MODE)=IS
CALL TYPE
REREAD 4177,RA,RB
IF(RA.NE.'SP')GO TO 5177
SET4=RB
C CAN SET SPACER HERE
GO TO 1177
5177 IF(INP1.EQ.IBLA) GO TO 1
IF(INP1.NE.'9')GO TO 80041
IF(INP2.EQ.'9')GO TO 99
C TYPE '99' TO BACK-UP
80041 IF(IREAD.GE.0)WRITE(21,2114)INP
6177 CALL LNEND
IF(MODE.GE.3)GO TO 133
RETRO=-1.
I=1
PARENS=0
MOT=0
JZ=1
IAMP=0
C IAMP IS 'BLANK LINE'FLAG ON PP1-3.
KL=0
RA=0
IF(MODE.EQ.2)GO TO 2408
C NEXT CHECKS FOR STAFF NUM AT FRONT OF INPUT LINE#1.
IF(INP(1).NE.'S')GO TO 2408
IF(INP(2).NE.'T')GO TO 2408
K=1
L=3
IF(INP3.NE.'-')GO TO 1277
K=-1
L=4
1277 STAFF=NALF(INP(L))*K
2277 MLX=L+1
IF(INP(MLX).NE.KSLA)GO TO 2277
MLX=MLX+1
GO TO 3277
2408 MLX=1
3277 L=-1
IF(RMODE2.EQ.2)CALL PRESCN
C GO SORT OUT THE NEW FORMAT
DO 2999 K=1,72
N=INP(K)
IF(N.EQ.IBLA)GO TO 2999
L=0
IF(N.EQ.ISTAR)GO TO 277
IF(N.NE.ISEMI)GO TO 2999
C READS 72 CHARS. INCLUDING ;.
277 INP(K+1)=ISEMI
GO TO 1773
C --- X/Y/Z* --- WITH NO SEMICOLON WORKS FOR THIS PROG. ONLY!
2999 CONTINUE
IF(IREAD)GO TO 8015
CALL TYPSTR('****** TRY AGAIN ***** ')
CALL TYPCRLF
CCC TYPE 6999
GO TO 1
CCC6999 FORMAT(' ****** TRY AGAIN ***** ')
CC GO TO 69
C ERROR IF NO '*' OR ';' AT END OF LINE.
1299 IF(JZ.NE.0)GO TO 1773
7773 IF(MODE.NE.2)GO TO 377
IF(RMODE2.EQ.2)GO TO 77732
C ↑↑↑↑↑↑ FOR NEW INPUT FORMAT
377 IF(IREAD.EQ.0)GO TO 77731
C BYPASS IF NOT USING EDIT FILE
IF(IREAD.EQ.-1)READ(22,21141),L,INP
IF(IREAD.EQ.-2)READ(22,2114)INP
C TO READ 2ND LINE OF NOTE INPUT, IF NEEDED
CO TYPE 8009,MODE,INP
CALL TYPOUT
GO TO 77732
77731 CALL TYPE
IF(INP1.EQ.IBLA)GO TO 7773
WRITE(21,2114)INP
77732 CALL LNEND
JM=-1
JZ=0
GO TO 2408
C 'LISTS' MUST END WITH ;
1773 JZ=0
DBST=1.
IF(XDBST)DBST=-DBST
XDBST=0
17731 ML=MLX
IF(PARENS.LE.0.)GO TO 975
C PARENS=-1, OPENS; =1, CLOSES; =0, NONE
3362 PARENS=0
MOT=I-LMOT
IF(LCNT+MOT.LT.198)GO TO 33621
CCC DATA NOMOR/30H(' NO ROOM FOR MOTIVE ',A1/) /
CALL TYPSTR(' NO ROOM FOR MOTIVE ')
CALL TYPCHR(JMOT,1)
CALL TYPCRLF
CCC TYPE NOMOR,JMOT
GO TO 1
33621 JLIST(LCNT+1)=MOT
LCNT=LCNT+2
DO 2140 JG=0,MOT-1
2140 RLIST(LCNT+JG)=V(LMOT+JG)
LCNT=LCNT+MOT
IF(IAMP)GO TO 3013
C FOR CLOSE PARENS ON LAST ITEM
C STORE MOTIVE IN RLIST ARRAY
975 DO 236 JDD=ML,72
JD=JDD
N=INP(JD)
C ((((())))) MAY 13,71 /Z (D4/E/X 2 3/) CS/ ETC. CAN USE 26 LABELS.
IF(N.EQ.ILP)GO TO 477
IF(N.EQ.IRP)GO TO 477
IF(N.NE.ICOL)GO TO 2361
477 INP(JD)=IBLA
IF(N.NE.ICOL)GO TO 1113
XDBST=-1.
GO TO 5362
C GO CHANGE IT TO A SEMIC. !!! CAN'T END LINE WITH :
C SO NXT NOTE WILL BE DBST (TYPE /F:A:C/ ETC.)
C DBSTS WILL BE ONLY ONE 'REP' UNIT X*0Z%~#&@
1113 L=JD-1
5113 IF(INP(L).NE.IBLA)GO TO 2113
L=L-1
GO TO 5113
2113 IF(N.EQ.IRP)GO TO 3361
C ONLY ONE () AS YET, NO NESTING
1140 JMOT=INP(L)
C MOTIVE NAME
DO 11401 JC=1,LCNT-1
IF(JMOT.NE.JLIST(JC))GO TO 11401
C FINDS DUPLICATE IDENTIFIER
CCC11402 FORMAT(' MOTIVIC (',A1,') USED TWICE')
CALL TYPSTR(' MOTIVIC (')
CALL TYPCHR(JMOT,1)
CALL TYPSTR(') USED TWICE')
CALL TYPCRLF
CCC TYPE 11402,JMOT
JLIST(JC)=0
C ZERO OUT PREVIOUS USE OF IDENTIFIER.
11401 CONTINUE
JLIST(LCNT)=JMOT
PARENS=-1.
C A PARENTH IS OPEN
INP(L)=IBLA
LMOT=I
C LMOT IS CURRENT POINT IN V ARRAY
GO TO 236
3361 IF(PARENS.NE.0)GO TO 33612
CCC DATA WARN/30H(' PARENTH ERROR - GOING ON'/)/
CALL TYPSTR('PARENTH ERROR - GOING ON')
CALL TYPCRLF
CCC TYPE WARN
33611 INP(JD)=IBLA
GO TO 236
33612 PARENS=1.
C SETS PARENS CLOSED FLAG
GO TO 33611
C NO INVERSIONS POSSIBLE NOW
2361 IF(N.NE.IAT)GO TO 5361
DO 113 L=1,72
K=JD+L
C K IS USED AT 240!!!
JG=INP(K)
IF(JG.NE.NEG)GO TO 7113
RETRO=0
INP(K)=IBLA
GO TO 113
7113 IF(JG.NE.IBLA)GO TO 4113
113 CONTINUE
4113 DO 6361 L=1,LCNT
IF(JG.NE.JLIST(L))GO TO 6361
VX1=0
DO 40 M=JD+2,72
JG=INP(M)
IF(JG.EQ.IBLA)GO TO 40
IF(JG.EQ.KSLA)GO TO 140
IF(JG.EQ.ISEMI)GO TO 140
IF(JG.EQ.ISTAR)GO TO 140
ML=M
GO TO 240
40 CONTINUE
240 JC=JM
JM=-1
INP(K)=IBLA
JN=0
C MUST BE ZERO IN SCANR
CALL SCANR
JM=JC
140 JC=1
KN=L+2
M=KN+JLIST(L+1)
IF(RETRO)GO TO 940
KN=M-1
M=L+1
JC=-1
RETRO=-1.
940 Z=RLIST(KN)
IF(VX1.EQ.0)GO TO 540
C " @Q N " WHERE N= DIATONIC STEPS IN 'NOTES' OR MULT FACTOR IN OTHERS.
IF(MODE.EQ.1)GO TO 440
C MODE 1 IS NOTES, 2 IS RHY.
V(I)=Z*VX1
GO TO 7361
440 IF(ABS(Z).GE.2000.)GO TO 540
C SKIPS NON-NOTES
RB=VX1
IF(Z)RB=-RB
C NOW TRANSPOSES BY DIAT. STEPS ONLY 100S=FLAT, 200S=SHARP, 300S=NAT
C NEG NUMS ARE CHORD NOTES.
V(I)=Z+RB
GO TO 7361
540 V(I)=Z
7361 I=I+1
KN=KN+JC
IF(KN.NE.M)GO TO 940
RB=V(I-1)
DO 8361 L=JD,72
JG=INP(L)
INP(L)=IBLA
IF(JG.EQ.KSLA)GO TO 9361
IF(JG.EQ.ISEMI)GO TO 93611
8361 IF(JG.EQ.ISTAR)IAMP=-1
9361 MLX=L
IF(IAMP.EQ.0)GO TO 17731
JZ=-1
93611 IF(IAMP)GO TO 3013
GO TO 7773
6361 CONTINUE
CCC TYPE 6362,JG
CALL TYPSTR(' MOTIVIC (')
CALL TYPCHR(JG,1)
CALL TYPSTR(') NOT FOUND')
CALL TYPCRLF
GO TO 11401
CCC GO TO 11402
CCC6362 FORMAT(' MOTIVIC (',A1,') NOT FOUND')
C @@@@@@@@@@@@@@@@@@@@@@@@@@
5361 IF(N.NE.KSLA)GO TO 636
5362 MLX=JD+1
JZ=-1
INP(JD)=ISEMI
436 IF(INP(MLX).NE.IBLA)GO TO 103
MLX=MLX+1
GO TO 436
636 IF(N.EQ.ISEMI)GO TO 103
936 IF(N.NE.IDOT)GO TO 736
L=INP(JD+1)
KL=NALF(L)
IF(L.LE.0)GO TO 577
IF(KL.LT.0)GO TO 577
IF(KL.LE.9)GO TO 236
C JUMP IF IT'S A NUMBER
577 IF(MODE.EQ.2)INP(JD)=1
C :::::::::******* ↑↑↑↑ MODE #?
GO TO 236
C CHANGES DOTTED RHYTHMS TO '1'S.
736 IF(N.NE.ISTAR)GO TO 236
IAMP=-1
INP(JD)=ISEMI
GO TO 103
236 CONTINUE
2114 FORMAT(72A1)
21141 FORMAT(I,72A1)
5016 IF(IAMP.GE.0)GO TO 1299
IF(PARENS.NE.0)GO TO 3362
C PARENS ARE STILL OPEN?
GO TO 3013
103 K=INP(ML)
C LAST SECTION
IF(K.EQ.ISEMI)GO TO 1014
C*********** MODE #?
IF(K.NE.IBLA) GO TO 1899
ML=ML+1
GO TO 103
1899 JN=0
C MUST BE ZERO IN SCANR
VX4=0
NOAC=0
CALL SCANR
IF(VX1.EQ.-99.)GO TO 4022
C NO MORE COMPOSITES IN RHYTH. DOTS ARE INDICATED BY 100S.
C RHYTH. NUMB IS KEPT HERE. DOTTED QUARTER IS NOW 104. DBL..=204
17 V(I)=VX1
IF(VX4.EQ.0)GO TO 115
IF(MODE.NE.1)GO TO 115
I=I+1
C FOR + OR -. AUTO OCTAVES, ETC.
V(I)=-VX1-VX4
115 IF(JJ.LE.1)GO TO 114
IF(MODE.NE.1)GO TO 171
IF(VX2.EQ.0)GO TO 171
C JUMP IF RHY OR 'X 4' ETC.
V(I)=18000.0+VX1*10.0+VX2/10.0
C PACKS 2 METER NUMS INTO ONE SLOT (18xyz.n xy=top, zn=bottom)
114 I=I+1
GO TO 5016
171 JC=1
JD=VX(JJ)-1
I=I+1
GO TO 5005
1014 JD=1
JC=1
C X4/ CREATES REP 1,4; A/// CREATES REP 1,3;
GO TO 5005
4022 JC=VX2+.3
JD=VX3-.5
IF(JJ.EQ.2)JD=1
C JD=HOW MANY TIMES, JC=HOW MANY NOTES
5005 N=0
DO 3005 K=I-1,1,-1
IF(V(K))GO TO 3005
IF(V(K).LT.3000)N=N+1
C COUNTS RESTS AND NOTES ONLY (NO CHORD NOTES)
3005 IF(N.EQ.JC)GO TO 4005
4005 IF(JC.GT.1)GO TO 7005
IF(MODE.EQ.1)NOAC=-1
C 5/76 ******* AF/// WILL CREATE AF/A//-- AN:FS/// = AN:FS/A:F// *******
C ACCIS ARE DROPPED WITH / OR Xn REPEAT. (BUT NOT WITH 'REP' OR '/X n,n/')
7005 JC=I-K
C ALL THIS IS TO FIND COMPLETE CHORDS, BARS, ETC. TO REPEAT.
C REPS WILL ONLY COUNT RHYTHMIC UNITS.!
DO 1005 K=1,JD
NL=I+JC-1
DO 2005 L=I,NL
KN=L-JC
RB=V(KN)
IF(NOAC.GE.0)GO TO 2005
IF(ABS(RB).GE.2000)GO TO 2005
C SKIP OVER IF NOT A NOTE
RB=AMOD(RB,100.0)+1000.0
IF(V(KN))RB=RB-2000.0
C DROPS ACCIS WHEN SLASH REP. OR 'X' IS USED.
2005 V(L)=RB
1005 I=I+JC
GO TO 5016
3013 IF(MODE.NE.2)GO TO 771
IF(I-1.NE.IRHY)GO TO 8015
C WRONG NUMBER OF ITEMS
771 V(I)=-99.
IF(MODE.NE.1)GO TO 132
C FOR ADDED NOTES ON SPACING STAFF
CALL NOTES
C SAVES TOTAL OF ITEMS FOR LABEL 168
67 CALL NEWR
GO TO 8006
132 IF(IREAD.GT.0)IREAD=-IREAD
CALL RHYTH
C =50 IS RHYTHM FOR TEXT
GO TO 67
134 WRITE(21,2114)INP
C WRITES TYPED IN REPLY TO 'ADD BEAMS?'
C ACCENTS ARE IN BEAMS SUBROUTINE
133 CALL BEAMS
IF(MODE.EQ.3)GO TO 135
IF(MODE.EQ.4)IBEAM=0
C ADJUSTS STEMS (IBEAM=0) IF BEAMS WERE ENTERED.
GO TO 8006
135 K=IS
CALL NEWR
IS=K
C ↑↑↑↑↑↑ TO ADD NEW ITEMS, SUCH AS PPP, MP, CRESC., ETC.(SEE 'MARKS')
GO TO 8006
END